home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 15 / BBS in a box XV-1.iso / Files / Tele / Pete Johnson / Mehit 3.0.b15<source>.sit / FileAndStuffIt.p < prev    next >
Encoding:
Text File  |  1991-07-25  |  10.3 KB  |  379 lines  |  [TEXT/PJMM]
  1. unit FileAndStuffIt;
  2.  
  3. interface
  4.  
  5. uses
  6.     Globals, HelloTabby, mehitFile, LogUtils;
  7.  
  8. type
  9.     FileSpecPtr = ^FileSpec;
  10.     FileSpec = record
  11.             v: Integer;{ volume refNum}
  12.             d: Longint;{ directory id}
  13.             n: string[31];{ file/folder name}
  14.             method: signedbyte;{ comp method - used in compression only}
  15.             deleteIt: boolean;{ delete original file/folder when done?}
  16.         end;
  17.     FileListHdl = ^FileListPtr;
  18.     FileListPtr = ^FileListRec;
  19.     FileListRec = record
  20.             count: integer;{ # of files/folders below}
  21.             ary: array[0..0] of filespec;{ array of files to act on}
  22.         end;
  23.  
  24. var
  25.     StuffRef: integer;
  26.     StuffResource: handle;
  27.     savePort: GrafPtr;
  28.     StuffItMode: integer;
  29.     modeString, StuffItVersion: str255;
  30.     StuffItExists: boolean;
  31.  
  32. procedure myCloseWD;
  33.  
  34. function GetDirInfo (ourPath: str255; var ourVRef: integer): OSErr;
  35.  
  36. function GetFileName (Input: str255): str255;
  37.  
  38. function GetPath (Input: str255): str255;
  39.  
  40. function DoStuff (theFiles: FileListHdl;    { list of files to compress}
  41.                             destFile: FileSpecPtr;        { result file name/location}
  42.                             title: Str255;                { title of progress windows}
  43.                             Addr: Ptr): OSErr;            { address to jump to (start of the resource)}
  44.  
  45. function FindStuffIt: boolean;
  46.  
  47. procedure CloseStuffIt;
  48.  
  49. procedure StuffMessages;
  50.  
  51. procedure StuffOne (fName: str255; StuffMode: StuffOpts; deleteFile: boolean);
  52.  
  53. implementation
  54.  
  55. {-----------------------------------------------------------------    }
  56.  
  57. function GetDirInfo;{(ourPath: str255; var ourVRef: integer): OSErr}
  58.  
  59.     var
  60.         i: integer;
  61.         ourDirRef: longint;
  62.         myWDPBRec: WDPBRec;
  63.         Error: OSErr;
  64.         tempString: str255;
  65.  
  66.     begin
  67.         while (ourPath[length(ourPath)] <> ':') & (length(ourPath) > 1) do
  68.             ourPath := copy(ourPath, 1, length(ourPath) - 1);
  69.         tempString := ourPath;        {make an extra copy since HGetVol truncates the string}
  70.         Error := HGetVol(@tempString, ourVRef, ourDirRef);
  71.         with myWDPBRec do
  72.             begin
  73.                 ioNamePtr := @ourPath;
  74.                 ioVRefNum := ourVRef;
  75.                 ioWDDirID := ourDirRef;
  76.                 ioWDProcID := MySignature;
  77.                 Error := PBOpenWD(@myWDPBRec, false);
  78.                 if ioVRefNum <> DefaultVol then    {StuffIt doesn't like being fed a working    }
  79.                     ourVRef := ioVRefNum            {directory when file is in default directory    }
  80.             end;
  81.         GetDirInfo := Error
  82.     end;
  83.  
  84. {-----------------------------------------------------------------    }
  85.  
  86. procedure myCloseWD;
  87.  
  88.     var
  89.         counter: integer;
  90.         myWDPBRec: WDPBRec;
  91.  
  92.     begin
  93.         counter := 0;
  94.         repeat
  95.             counter := succ(counter);
  96.             with myWDPBRec do
  97.                 begin
  98.                     ioCompletion := nil;
  99.                     ioWDProcID := mySignature;
  100.                     ioWDIndex := counter;
  101.                     ioVRefNum := 0;
  102.                 end;
  103.             Err := PBGetWDInfo(@myWDPBRec, false);
  104.             if Err = noErr then
  105.                 Err := PBCloseWD(@myWDPBRec, false);
  106.         until Err <> noErr
  107.     end;
  108.  
  109. {-----------------------------------------------------------------    }
  110.  
  111. function GetFileName;{(Input: str255): str255}
  112.  
  113.     begin
  114.         while (pos(':', Input) > 0) & (length(Input) > 1) do
  115.             Input := copy(Input, pos(':', Input) + 1, 255);
  116.         GetFileName := Input
  117.     end;
  118.  
  119. { ------------------------------------------------------ }
  120.  
  121. function GetPath;{ (Input: str255): str255}
  122.  
  123.     begin
  124.         while not (Input[length(Input)] in [':']) & (length(Input) > 1) do
  125.             Input := copy(Input, 1, length(Input) - 1);
  126.         if length(Input) = 1 then
  127.             Input := ':';
  128.         GetPath := Input
  129.     end;
  130.  
  131. { ------------------------------------------------------ }
  132.  
  133. function Stuff (theFiles: FileListHdl;    { list of files to compress}
  134.                                 destFile: FileSpecPtr;    { result file name/location}
  135.                                 title: Str255;           { title of progress windows}
  136.                                 Addr: Ptr): OSErr;        { address to jump to (start of the resource)}
  137.  
  138.  
  139. inline
  140.     $205F, $4E90; { pop last param & jump to it}
  141.  
  142. {-----------------------------------------------------------------    }
  143.  
  144. function DoStuff;
  145. {        (theFiles: FileListHdl;    list of files to compress}
  146. {        destFile: FileSpecPtr;    result file name/location}
  147. {        title: Str255;            title of progress windows}
  148. {        Addr: Ptr): OSErr;        address to jump to (start of the resource)}
  149.  
  150.  
  151.     begin
  152.         Err := Stuff(theFiles, destFile, title, Addr)
  153.     end;
  154.  
  155. {-----------------------------------------------------------------    }
  156.  
  157. function FindStuffIt;{: boolean}
  158.  
  159.     var
  160.         error: OSErr;
  161.         theWorld: SysEnvRec;
  162.         StuffVRef: integer;
  163.         SystemPath: str255;
  164.  
  165.     begin
  166.         StuffResource := nil;
  167.         error := SysEnvirons(1, theWorld);
  168.         StuffVRef := theWorld.sysVRefNum;    {it's in the System Folder}
  169.         MakePath('System', StuffVRef, SystemPath);
  170.         if error = noErr then
  171.             StuffRef := OpenResFile(concat(SystemPath, 'Extensions:StuffIt Engine™'));
  172.         if (StuffRef <> -1) then
  173.             begin
  174.                 StuffResource := Get1IndResource('MENC', 1);
  175.                 GetPort(savePort); { Only needed when calling v1.0 of the engine}
  176.             end;
  177.         if (error = noErr) & (StuffRef <> -1) then
  178.             begin
  179.                 FindStuffIt := true;
  180.                 StuffItExists := true;
  181.                 StuffItVersion := ReadVersion
  182.             end
  183.         else
  184.             FindStuffIt := false
  185.     end;
  186.  
  187. {-----------------------------------------------------------------    }
  188.  
  189. procedure CloseStuffIt;
  190.  
  191.     begin
  192.         if StuffResource <> nil then
  193.             begin
  194.                 ReleaseResource(StuffResource);
  195.                 CloseResFile(StuffRef);
  196.                 StuffResource := nil;
  197.             end
  198.     end;
  199.  
  200. {-----------------------------------------------------------------    }
  201.  
  202. procedure StuffMessages;
  203.  
  204.     var
  205.         destFile: FileSpec;
  206.         StuffFilesHandle: FileListHdl;
  207.         i, backupVol, MESSAGESVol, MFilesVol, ULVol: integer;
  208.         aString, introString: str255;
  209.         beginStuffTime, endStuffTime, StuffTime: longint;
  210.         stuffMin, stuffSec: integer;
  211.         StuffErr: OSErr;
  212.  
  213.     begin
  214.         StuffFilesHandle := nil;
  215.         if FindStuffIt & (DefaultsPtr^.DBackupMode in [StuffNone..StuffBetter]) then
  216.             begin
  217.                 if DefaultsPtr^.WriteToTabby then
  218.                     begin
  219.                         TimeStamp;
  220.                         Err := FSOpen(concat(gDefaultpath, 'Tabby:Tabby Log'), DefaultVol, TLogRef);
  221.                         Err := SetFPos(TLogRef, fsFromLEOF, 0);
  222.                         Err := WrLn(TLogRef, concat(DateString, ' mehitabel - stuffing with engine ', StuffItVersion, ' using ''', modeString, ''' mode'));
  223.                     end;
  224.                 GetDateTime(beginStuffTime);
  225.                 StuffItMode := ord(DefaultsPtr^.DBackupMode) - 3;
  226.                 Err := GetDirInfo(concat(DefaultsPtr^.DBackupPath, 'Messages.sit'), backupVol);
  227.                 Err := GetDirInfo(MESSAGESPath, MESSAGESVol);
  228.                 Err := GetDirInfo(MsgPath, MFilesVol);
  229.                 Err := GetDirInfo(ULPath, ULVol);
  230.                 Err := FSDelete(concat(DefaultsPtr^.DBackupPath, 'Messages.sit'), backupVol);
  231.                 with destFile do
  232.                     begin
  233.                         v := BackupVol;
  234.                         d := 0;
  235.                         n := concat(DefaultsPtr^.DBackupPath, 'Messages.sit');
  236.                         method := StuffItMode;
  237.                         deleteIt := false;
  238.                     end;
  239.                 StuffFilesHandle := FileListHdl(NewHandle((sizeOf(FileListHdl)) + (4 * sizeOf(filespec))));
  240.                 MoveHHi(Handle(StuffFilesHandle));
  241.                 HLock(Handle(StuffFilesHandle));
  242.                 with StuffFilesHandle^^ do
  243.                     begin
  244.                         count := 4;
  245.                         with ary[0] do
  246.                             begin
  247.                                 v := MESSAGESVol;
  248.                                 d := 0;
  249.                                 n := 'MESSAGES';
  250.                                 method := StuffItMode;
  251.                                 deleteIt := false
  252.                             end;
  253.                         with ary[1] do
  254.                             begin
  255.                                 v := MFilesVol;
  256.                                 d := 0;
  257.                                 n := 'MSGHDR';
  258.                                 method := StuffItMode;
  259.                                 deleteIt := false
  260.                             end;
  261.                         with ary[2] do
  262.                             begin
  263.                                 v := MFilesVol;
  264.                                 d := 0;
  265.                                 n := 'MSGTXT';
  266.                                 method := StuffItMode;
  267.                                 deleteIt := false
  268.                             end;
  269.                         with ary[3] do
  270.                             begin
  271.                                 v := ULVol;
  272.                                 d := 0;
  273.                                 n := 'UserLog';
  274.                                 method := StuffItMode;
  275.                                 deleteIt := false
  276.                             end;
  277.                     end;
  278.                 MoveHHi(StuffResource);
  279.                 HLock(StuffResource);
  280.                 StuffErr := Stuff(StuffFilesHandle, @destFile, 'shrinking backups', StuffResource^);
  281.                 HUnlock(StuffResource);
  282.                 HUnlock(Handle(StuffFilesHandle));
  283.                 if StuffFilesHandle <> nil then
  284.                     begin
  285.                         DisposHandle(Handle(StuffFilesHandle));
  286.                         StuffFilesHandle := nil;
  287.                     end;
  288.                 CloseStuffIt;
  289.                 SetPort(savePort); { Only needed when calling v1.0 of the engine}
  290.                 if DefaultsPtr^.WriteToTabby then
  291.                     begin
  292.                         TimeStamp;
  293.                         introString := concat(DateString, ' mehitabel - ');
  294.                         if StuffErr = noErr then
  295.                             begin
  296.                                 GetDateTime(endStuffTime);
  297.                                 StuffTime := endStuffTime - beginStuffTime;
  298.                                 stuffMin := StuffTime div 60;
  299.                                 stuffSec := StuffTime mod 60;
  300.                                 aString := StringOf(stuffSec : 1);
  301.                                 while length(aString) < 2 do
  302.                                     aString := concat('0', aString);
  303.                                 aString := concat(introString, 'stuffing time ', StringOf(stuffMin : 1), ':', aString, '  free memory: ', stringOf(freeMem div 1024 : 1), 'K')
  304.                             end
  305.                         else if StuffErr = -1 then
  306.                             aString := concat(introString, 'stuffit cancelled')
  307.                         else
  308.                             aString := concat(introString, 'stuffit error ', stringOf(StuffErr : 1));
  309.                         Err := WrLn(TLogRef, aString);
  310.                         Err := FSClose(TLogRef);
  311.                     end;
  312.             end;{if FindStuffIt & (DefaultsPtr^.DBackupMode in [StuffNone..StuffBetter])}
  313.         if err <> noErr then
  314.             err := noErr;
  315.         SetCursor(GetCursor(1000)^^)
  316.     end;
  317.  
  318. {-----------------------------------------------------------------    }
  319.  
  320. procedure StuffOne;{(fName: str255; StuffMode: StuffOpts; deleteFile: boolean)}
  321.  
  322.     var
  323.         destFile: FileSpec;
  324.         StuffFilesHandle: FileListHdl;
  325.         i, backupVol, sourceVol: integer;
  326.         aString, introString, tempName: str255;
  327.         StuffErr: OSErr;
  328.  
  329.     begin
  330.         StuffFilesHandle := nil;
  331.         if FindStuffIt then
  332.             begin
  333.                 Err := GetDirInfo(concat(fName), sourceVol);
  334.                 tempName := concat(GetFileName(fName), '.sit');
  335.                 Err := GetDirInfo(concat(DefaultsPtr^.DBackupPath, tempName), backupVol);
  336.                 Err := FSDelete(concat(DefaultsPtr^.DBackupPath, tempName), backupVol);
  337.  
  338.                 with destFile do
  339.                     begin
  340.                         v := BackupVol;
  341.                         d := 0;
  342.                         n := tempName;
  343.                         method := ord(StuffMode);
  344.                         deleteIt := false;
  345.                     end;
  346.                 StuffFilesHandle := FileListHdl(NewHandle((sizeOf(FileListHdl)) + (1 * sizeOf(filespec))));
  347.                 MoveHHi(Handle(StuffFilesHandle));
  348.                 HLock(Handle(StuffFilesHandle));
  349.                 with StuffFilesHandle^^ do
  350.                     begin
  351.                         count := 1;
  352.                         with ary[0] do
  353.                             begin
  354.                                 v := sourceVol;
  355.                                 d := 0;
  356.                                 n := GetFileName(fName);
  357.                                 method := ord(StuffMode);
  358.                                 deleteIt := deleteFile
  359.                             end;
  360.                     end;
  361.                 MoveHHi(StuffResource);
  362.                 HLock(StuffResource);
  363.                 StuffErr := Stuff(StuffFilesHandle, @destFile, 'shrinking log', StuffResource^);
  364.                 HUnlock(StuffResource);
  365.                 HUnlock(Handle(StuffFilesHandle));
  366.                 if StuffFilesHandle <> nil then
  367.                     begin
  368.                         DisposHandle(Handle(StuffFilesHandle));
  369.                         StuffFilesHandle := nil;
  370.                     end;
  371.                 CloseStuffIt;
  372.                 SetPort(savePort) { Only needed when calling v1.0 of the engine}
  373.             end;
  374.         SetCursor(GetCursor(1000)^^)
  375.     end;
  376.  
  377. {-----------------------------------------------------------------    }
  378.  
  379. end.